00100	STACKS
00200	
00300	In Version 0, the P Stack will be non-relocatable and totally
00400	contiguous.  FUNARGS, REFS, and OLD will not be implemented.  The
00500	stack extends from P0 to P.
00600	
00700	The stack is in PIECES, one for each live context.  The bottom of the
00800	current piece is at PBASE.  At PBASE there is a header.  Above the
00900	header is the current piece of stack.  If the stack "underflows", the
01000	last RETURN will jump through a specially modified R.A.  to the
01100	SUCCESSBLT routine.  This routine will find the real R. A. in the
01200	header, find the next portion of stack that has to be BLT'ed from the
01300	header, BLT's it up (if its context no. is different), updates the
01400	header, modifies the lowest R. A. to SUCCESSBLT, corrects P, and
01500	continues.
01600	
01700	At a decision point, a new stack piece is created just above P, and
01800	the first portion of the stack is BLT'ed up there.  The state stack
01900	keeps a record of the original PBASE.  The header of each piece
02000	records the value of P last time it was the current piece, and the
02100	number of the context that existed just before the DPNT.
02200	
02300	Upon failure, PBASE is restored from SS and then P is restored from
02400	the piece header.
02500	
02600	PRUNE makes big holes in the P stack, but they will be passed over
02700	upon later successes.  Only small holes are made in SS; they can be
02800	garbage collected occasionally.
02900	
03000	In the special case of extendable functions, the automatics are saved
03100	at the beginning and at each ALT, but the P stack is only saved at →.
03200	(At →→, a PRUNE is done instead).
03300	
03400	The automatics include P, TP, and whatever else the user declares
03500	AUTOMATIC.  There is a table of PUSHes that is executed by the DPNT
03600	routine.  Failure performs a POP indirect loop through this table to
03700	restore the automatics.
03800	
03900	It is necessary for PRUNE to correct the context number stored in the
04000	stack piece just below the hole it makes.
     

00100	STACK PIECE
00200	
00300	
00400			|---------------|
00500		P →→→→→→→		|
00600			|---------------|
00700			|		|
00800			↓	↓	↓
00900			|		|
01000			|---------------|
01100		(old RA)|   `SUCCESSBLT'|
01200			|---------------|
01300			|		|
01400			|  (arguments)	|
01500			|		|
01600			|---------------|
01700			|place to save P|
01800			|---------------|
01900			|     BLT1	|
02000			|---------------|
02100			|     BLT0	|
02200			|---------------|
02300			|    real R.A.	|
02400			|---------------|
02500		PBASE→→→→  CONTEXT NO.	|
02600			|---------------|
02700		OLD P →→→		|
02800			↓	↓	↓
02900			|		|
03000			|---------------|
03100		        |   real R.A.	|←←←initial BLT1
03200			|---------------|
03300			|		|
03400			↓	↓	↓
03500			|		|
03600			|---------------|
03700			|   `SUCCESSBLT'|
03800			|---------------|
03900			|		|
04000			|  (arguments)	|
04100			|		|
04200			|---------------|
04300			|     OLD P	|
04400			|---------------|
04500			|   old BLT1	|
04600			|---------------|
04700			|   old BLT0	|
04800			|---------------|
04900			| real old R.A.	|
05000			|---------------|
05100	    old	PBASE→→→→  CONTEXT NO.	|←←←initial BLT0
05200			|---------------|
     

00100	STATE STACK LAYOUT
00200	----- ----- ------
00300	
00400	
00500			SS REGISTER		STATE STACK
00600			 ---------------	 * * * * * * * *
00700			|	|	|	|---------------|
00800			| COUNT	|SS TOP>>>>>>>>>|  →UNDO ROUTINE|
00900			|	|	|	|---------------|
01000			 ----------------	|   THINGS	|
01100						|     TO BE	|	
01200						|    RESTORED	|
01300						|---------------|
01400						|  →UNDO ROUTINE|
01500						|---------------|
01600						|   THINGS	|
01700						|     TO BE	|
01800						|    RESTORED	|
01900						|---------------|
02000						 ↓	↓      ↓
02100						 .	.      .
02200						 ↓	↓      ↓
02300			CTAG REGISTER		|---------------|
02400			 ---------------	|  →RSTR_CONTEXT|
02500			|CURRENT |BACKUP|	|---------------|
02600			|CONTEXT | MODE	|	|   SAVED TP	|
02700			|  TAG	 | (0-3)|	|---------------|
02800			 ---------------	|		|
02900			CBASE REGISTER		|  SAVED PBASE  |
03000			 ---------------	|		|
03100			|	|	|	|---------------|
03200			| COUNT	|SS MARK>>>>>>>>|  SAVED CBASE >>>>∨
03300			|	|	|	|---------------|  ∨
03400			 ---------------	|  SAVED CTAG	|  ∨
03500						|---------------|  ∨
03600						|FAILURE ADDRESS|  ∨
03700						|---------------|  ∨
03800						|		|  ∨
03900						 ↓   ↓  ↓  ↓   ↓   ↓
     

00100	SPECIAL LAYOUT FOR EXTENDABLE FUNCTIONS
00200	------- ------ --- ---------- ---------
00300	
00400			SS REGISTER		STATE STACK
00500			 ---------------	 * * * * * * * *
00600			|	|	|	|---------------|
00700			| COUNT	|SS TOP>>>>>>>>>|  →UNDO ROUTINE|
00800			|	|	|	|---------------|
00900			 ----------------	| THINGS TO BE	|
01000						|   RESTORED	|
01100						|---------------|
01200						 ↓	↓      ↓
01300			CTAG REGISTER		|---------------|
01400			 ---------------	|      →RSTR_DEC|<<<<<<<<
01500			|CURRENT|BACKUP |	|---------------|	∧
01600			|CONTEXT| MODE	|	|   SAVED TP	|	∧
01700			|  TAG	| (0-3)	|	|---------------|	∧
01800			 ---------------	|  SAVED PBASE	|	∧
01900						|---------------|	∧
02000						|  ITS  |	|	∧
02100						|CONTEXT|SS MARK>>>∨	∧
02200						|  TAG	|	|  ∨	∧
02300						|---------------|  ∨	∧
02400						 ↓	↓      ↓   ∨	∧
02500						|---------------|  ∨	∧
02600						|      →NEXT_ALT|  ∨	∧
02700						|---------------|  ∨	∧
02800						|   SAVED TP	|  ∨	∧
02900						|---------------|  ∨	∧
03000						|   SAVED P	|  ∨	∧
03100						|---------------|  ∨	∧
03200						| →NEXT ALT ADDR|  ∨	∧
03300						|---------------|  ∨	∧
03400						↓	↓      ↓   ∨	∧
03500						|---------------|  ∨	∧
03600			CBASE REGISTER		|         →ERASE|  ∨	∧
03700			 --------------- 	|---------------|  ∨	∧
03800			|	|	|	|     SAVED	|<<<	∧
03900			| COUNT |SS MARK>>>>>>>>|     CBASE     |	∧
04000			|  	|       |  	|    REGISTER  >>>>∨	∧
04100			 ---------------	|---------------|  ∨	∧
04200						|   SAVED CTAG	|  ∨	∧
04300					      	|---------------|  ∨	∧
04400						|    POINTER   >>>>⊗>>>>∧
04500			 			|---------------|  ∨
04600						|		|  ∨
04700						 ↓   ↓  ↓  ↓   ↓   ↓
     

00100	SELECT MACRO
00200	
00300	SELECT E0 FROM I: E1 NEXT E2 UNLESS E3 IN WHICH CASE E4
00400	
00500		BEGIN
00600		NEW I ;
00700		I ← E1 ; GO TO CHECK ;
00800		TRYNEXT:
00900		I ← E2 ;
01000		CHECK:
01100		IF E3 THEN RETURN(E4) ;
01200		DPNT('TRYNEXT) ;
01300		RETURN(E0) ;
01400		END
01500	
01600	FUNCTION CHOICE(INTEGER N) =
01700		SELECT I FROM I:1 NEXT I+1 UNLESS I>N IN WHICH CASE FAIL ;
01800	
01900	CONTEXTUAL FUNCTION DPNT(L) =	% called by PUSHJ SS, DPNT %
02000		BEGIN WORLD BLT1, BLT0, BLT2, BLTB, TEMP, X, RA, SIZE ;
02100		PUSH(SS) ← CTAG ;
02200		PUSH(SS) ← CBASE ;
02300		CBASE ← SS ;
02350		BLT1←P ; BLT0←PBASE ; BLTB←PBASE+5 ; RA←REALRA(PBASE) ;
02400		OLDP(PBASE) ← P ;  PUSH(P) ← CTAG ;
02500		CTAG ← CTAG + 8 ;
02600		PUSH(SS) ← PBASE ;
02700		PUSH(SS) ← TP ;
02800		PUSH(SS) ← 'RESTORE_CONTEXT ;
02900		SIZE ← BLT1 - BLTB + XWD(1,1) ;
03000		TEMP ← P ;
03100		IF SIZE GREATERP MAXBLT ∧ BLT2←SMALLER_PIECE() THEN
03200			BEGIN
03300			PUSH(P) ← RA ;
03400			PUSH(P) ← PBASE ;
03500			PUSH(P) ← BLT2 ;
03600			END
03700		ELSE	BEGIN
03800			PUSH(P) ← RA ;
03900			PUSH(P) ← X ← OLDBLT0(BLT0) ;
04000			PUSH(P) ← OLDP(X) ;
04050			END ;
04100		PUSH(P) ← * ;
04200		PUSH(P) ← BLOCK[BLT0 FOR SIZE] ;
04300		PBASE ← TEMP ;
04400		END ;
     

00100	LET PUSHSTACK(*,*,S,*,*,E) IDEXP =
00200		{
00300		PUSH
00400		?(
00500		<EXPR>
00600		?)
00700		?←
00800		{ALT
00900			BLOCK ?[ <EXPR> FOR <EXPR> ?]
01000		|	{REP 1 M * {?*}}
01100		|	<EXPR>
01200		}
01300		}
01400		MEAN
01500		CASE E[1] OF
01600			BEGIN
01700			<'PUSH_BLOCK, S, E[4], E[6]> ;
01800			<'PUSH_NONDESTRUCTIVE, S, LENGTH(E)> ;
01900			<'PUSH_ENTITY, S, E[2]> ;
02000			END ;
     

00100	HAND_CODED DPNT (TEMPORARY)
00200	
00300		PUSH SS, CTAG
00400		PUSH SS, CBASE
00500		MOVE CBASE, SS
00600		MOVEM P, BLT1
00700		MOVE REG1, PBASE
00800		MOVEM REG1, BLT0
00900		ADD REG1, [5,,5]
01000		MOVEM REG1, BLTB
01100		MOVE REG2, -4(REG1)
01200		MOVEM REG2, RA
01300		PUSH P, CTAG
01400		ADDI CTAG, 8
01500		PUSH SS, PBASE
01600		PUSH SS, TP
01700		PUSH SS, =RESTORE_CONTEXT
01800		MOVE REG2, BLT1
01900		SUB REG2, BLTB
02000		ADD REG2, [1,,1]
02100		MOVEM P, TEMP
02200		MOVEM REG2, SIZE
02300		CAMG REG2, MAXBLT
02400		JRST OKBLT
02500		PUSHJ P, SMALLER_PIECE
02600		JUMPE VAL, OKBLT
02700		PUSH P, RA
02800		PUSH P, PBASE
02900		PUSH P, VAL
03000		JRST GOON
03100	OKBLT	PUSH P, RA
03200		MOVE REG1, BLT0
03300		MOVE REG1, 2(REG1)
03400		PUSH P, REG1
03500		PUSH P, 4(REG1)
03600	GOON	AOBJP P, .+2
03700		JSA VAL, PSTACKOFLO
03800		HRR REG1, P
03900		HRL REG1, BLT0
04000		ADD P, SIZE
04100		JUMPG P, DOBLT
04200		<ERROR>
04300	DOBLT	BLT REG1, (P)
04400		MOVE REG1, TEMP
04500		MOVEM REG1, PBASE
04600		END